Greeting = "Greetings. What would you like to talk about?"
Case 3
Greeting = "Good day. Please tell me your problems."
Case 4
Greeting = "What is on your mind today?"
Case 5
Greeting = "Please begin when you are ready."
Case Else
Greeting = "Hello, what is your question?"
End Select
End Function
Public Function NewReply(LastReply As String, Question As String) As String
Dim Choice As Integer
Dim Location As Integer
Dim TempReply As String
Randomize
Question = UCase(Question)
Do ' This Do-Until loop keeps ELIZA from repeating herself
Do
' Check for "How", "Who", "What", "When", "Why", or "Where" keywords
If ((InStr(Question, "HOW")) > 0) Or ((InStr(Question, "WHO")) > 0) Or ((InStr(Question, "WHAT")) > 0) Or ((InStr(Question, "WHEN")) > 0) Or ((InStr(Question, "WHERE")) > 0) Or ((InStr(Question, "WHY")) > 0) Then
Choice = CInt(9 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "Why do you ask?"
Case 2
NewReply = "Does that question interest you?"
Case 3
NewReply = "What answer would please you the most?"
Case 4
NewReply = "Are such questions on your mind often?"
Case 5
NewReply = "What is it that you really want to know?"
Case 6
NewReply = "Have you asked anyone else?"
Case 7
NewReply = "Have you asked such questions before?"
Case 8
NewReply = "What else comes to mind when you ask that?"
Case Else
NewReply = "What do you think?"
End Select
Exit Do
End If
' Check for "Mother", "Father", "Brother", "Sister", or "Family" keywords
If ((InStr(Question, "MOTHER")) > 0) Or ((InStr(Question, "BROTHER")) > 0) Or ((InStr(Question, "WHAT")) > 0) Or ((InStr(Question, "WHEN")) > 0) Or ((InStr(Question, "SISTER")) > 0) Or ((InStr(Question, "FAMILY")) > 0) Then
Choice = CInt(9 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "Why do you mention your family?"
Case 2
NewReply = "Did you get along with your family?"
Case 3
NewReply = "How does your family treat you?"
Case 4
NewReply = "Were you ever close to your family?"
Case 5
NewReply = "Did you have a happy childhood?"
Case 6
NewReply = "Do you like your family members?"
Case 7
NewReply = "Did your family ask you to talk to me?"
Case 8
NewReply = "What kind of childhood did you have?"
Case Else
NewReply = "Do you think about your family often?"
End Select
Exit Do
End If
' Check for "Hello" answer
If ((InStr(Question, "HELLO")) > 0) Then
Choice = CInt(4 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "How do you do. How can I help you?"
Case 2
NewReply = "Greetings to you too. What shall we talk about today?"
Case 3
NewReply = "Bon jour. Shall we get to business now?"
Case Else
NewReply = "Please make yourself comfortable and let's begin, shall we?"
End Select
Exit Do
End If
' Check for profanity
If ((InStr(Question, "FUCK")) > 0) Or ((InStr(Question, "SHIT")) > 0) Or ((InStr(Question, "HELL")) > 0) Or ((InStr(Question, "DAMN")) > 0) Then
Choice = CInt(4 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "Please don't use four-letter words."
Case 2
NewReply = "Profanity is not necessary."
Case 3
NewReply = "Do you use such foul language often?"
Case Else
NewReply = "You don't have to use profanity to express yourself."
End Select
Exit Do
End If
' Check for "Name" keyword
If ((InStr(Question, "NAME")) > 0) Then
Choice = CInt(4 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "As Shakespeare said, 'What's in a name?'"
Case 2
NewReply = "Are names important to you?"
Case 3
NewReply = "Why do you mention names at all?"
Case Else
NewReply = "Names are not important at this time."
End Select
Exit Do
End If
' Check for "Thank" keyword
If ((InStr(Question, "THANK")) > 0) Then
Choice = CInt(4 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "You're welcome."
Case 2
NewReply = "No problem."
Case 3
NewReply = "I'm always glad to be of service to you."
Case Else
NewReply = "Do you feel better now?"
End Select
Exit Do
End If
' Check for "Cause" keyword
If ((InStr(Question, "CAUSE")) > 0) Then
Choice = CInt(4 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "Is that the real reason?"
Case 2
NewReply = "Do any other reasons come to mind?"
Case 3
NewReply = "Does that reason explain anything else?"
Case Else
NewReply = "What other reasons might there be?"
End Select
Exit Do
End If
' Check for "Sorry" keyword
If ((InStr(Question, "SORRY")) > 0) Then
Choice = CInt(5 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "Please don't feel the need to apologize."
Case 2
NewReply = "Apologies are not necessary."
Case 3
NewReply = "How do you feel when you apologize?"
Case 4
NewReply = "Don't be so defensive."
Case Else
NewReply = "That's okay. Please continue."
End Select
Exit Do
End If
' Check for "Dream" keyword
If ((InStr(Question, "DREAM")) > 0) Then
Choice = CInt(5 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "What does that dream suggest to you?"
Case 2
NewReply = "Do you dream often?"
Case 3
NewReply = "Are you disturbed by dreams?"
Case 4
NewReply = "Dreaming is natural."
Case Else
NewReply = "What do your dreams reveal about your thoughts?"
End Select
Exit Do
End If
' Check for "Maybe" keyword
If ((InStr(Question, "MAYBE")) > 0) Then
Choice = CInt(6 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "You don't seem quite certain."
Case 2
NewReply = "Why the uncertain tone?"
Case 3
NewReply = "Can't you be more positive?"
Case 4
NewReply = "You aren't sure?"
Case 5
NewReply = "Don't you know?"
Case Else
NewReply = "Perhaps that might be true after all."
End Select
Exit Do
End If
' Check for "Always" keyword
If ((InStr(Question, "ALWAYS")) > 0) Then
Choice = CInt(5 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "Can you think of an example?"
Case 2
NewReply = "When?"
Case 3
NewReply = "What are you thinking about now?"
Case 4
NewReply = "Really...always?"
Case Else
NewReply = "Perhaps that might be true occasionally."
End Select
Exit Do
End If
' Check for "Alike" keyword
If ((InStr(Question, "ALIKE")) > 0) Then
Choice = CInt(7 * Rnd + 1)
Select Case Choice
Case 1
NewReply = "In what way?"
Case 2
NewReply = "What similarities do you see?"
Case 3
NewReply = "What does the similarity suggest to you?"
